home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / HEAPSPY.ZIP / HWCLASS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  4.5 KB  |  182 lines
  1. {$A-,B-,E-,F-,G+,I-,K-,N-,O-,P-,Q-,R-,S-,T+,V-,W-,X+}
  2.  
  3. {**********************************************}
  4. {                                              }
  5. {   HeapSpy - HWClass module                   }
  6. {   Copyright (c) 1992  Borland International  }
  7. {                                              }
  8. {**********************************************}
  9.  
  10. unit HWClass;
  11.  
  12. {$C MOVEABLE DEMANDLOAD DISCARDABLE}
  13.  
  14. interface
  15.  
  16. uses Wintypes, WinProcs, Objects, ODialogs, OWindows, BWCC, Strings,
  17.   WinDOS, Toolhelp, HWGlobal;
  18.  
  19. type
  20.   PClassWin = ^TClassWin;
  21.   TClassWin = object(TListWin)
  22.     DetWin : PWindow;
  23.     destructor Done; virtual;
  24.     procedure SetupWindow;  virtual;
  25.     procedure BuildList; virtual;
  26.     function GetItemString(P : Pointer) : PChar; virtual;
  27.     procedure DeleteItem(P : Pointer); virtual;
  28.     function HandleSelect(LeftClick : Boolean) : Boolean; virtual;
  29.   end;
  30.  
  31. implementation
  32.  
  33. type
  34.   PClassDlg = ^TClassDlg;
  35.   TClassDlg = object(TBWCCDlg)
  36.     CE: PClassEntry;
  37.     constructor Init(AParent: PWindowsObject; AClassEntry: PClassEntry);
  38.     procedure SetupWindow; virtual;
  39.     procedure SetDlgInt(ID: Word; V: Word);
  40.     procedure SetDlgPtr(ID: Word; V: Pointer);
  41.     procedure SetDlgText(ID: Word; V: PChar);
  42.   end;
  43.  
  44. constructor TClassDlg.Init;
  45. begin
  46.   inherited Init(AParent,'ClassInfo',0);
  47.   CE := AClassEntry;
  48. end;
  49.  
  50. procedure TClassDlg.SetDlgInt;
  51. var
  52.   S: array[0..7] of char;
  53. begin
  54.   HexW(S, V);
  55.   SendDlgItemMsg(ID, wm_SetText, 0, LongInt(@S));
  56. end;
  57.  
  58. procedure TClassDlg.SetDlgPtr;
  59. var
  60.   S: array[0..12] of char;
  61. begin
  62.   HexPtr(s,V);
  63.   SendDlgItemMsg(ID, wm_SetText, 0, LongInt(@S));
  64. end;
  65.  
  66. procedure TClassDlg.SetDlgText;
  67. begin
  68.   SendDlgItemMsg(ID, wm_SetText, 0, LongInt(V));
  69. end;
  70.  
  71.  
  72. procedure TClassDlg.SetupWindow;
  73. var
  74.   WndClass: TWndClass;
  75.   I: integer;
  76. const
  77.   CS_Lits: array[0..15] of PChar = (
  78.    'VRedraw', 'HRedraw', 'KeyCvtWindow', 'DblClks', '0010', 'OwnDC',
  79.    'ClassDC', 'ParentDC', 'NoKeyCVT', 'NoClose', '0400', 'SaveBits',
  80.    'ByteAlignClient', 'ByteAlignWindow', 'GlobalClass', 'UseDefault');
  81. begin
  82.   inherited SetupWindow;
  83.   with CE^ do
  84.     GetClassInfo(hInst,szClassName,WndClass);
  85.   SetDlgText(ci_ClassName,CE^.szClassName);
  86.   with WndClass do
  87.   begin
  88.     SetDlgInt(ci_Style,style);
  89.     SetDlgInt(ci_hCursor,hCursor);
  90.     SetDlgInt(ci_HIcon,hIcon);
  91.     SetDlgPtr(ci_lpfnWndProc,lpfnWndProc);
  92.     SetDlgInt(ci_cbClsExtra,cbClsExtra);
  93.     SetDlgInt(ci_cbWndExtra,cbWndExtra);
  94.     SetDlgInt(ci_hInstance,hInstance);
  95.     SetDlgInt(ci_hbrBackground,hbrBackground);
  96.     for i := 0 to 15 do
  97.     begin
  98.       if Odd(Style) then
  99.         SendDlgItemMsg(ci_StyleList,LB_ADDSTRING,0,LongInt(CS_Lits[i]));
  100.       Style := Style shr 1;
  101.     end;
  102.   end;
  103. end;
  104.  
  105. destructor TClassWin.Done;
  106. begin
  107.   inherited Done;
  108. end;
  109.  
  110. procedure TClassWin.BuildList;
  111. var
  112.   CE: TClassEntry;
  113.   CEP: PClassEntry;
  114.   Temp: array[0..127] of char;
  115.   ModName: array[0..fsFileName] of char;
  116. begin
  117.  CE.dwSize := sizeof(TClassEntry);
  118.  ClassFirst(@CE);
  119.  repeat
  120.    New(CEP);
  121.    Move(CE,CEP^,Sizeof(TClassEntry));
  122.    List^.InsertString(PChar(CEP),0);
  123.  until not ClassNext(@CE);
  124. end;
  125.  
  126. procedure TClassWin.SetupWindow;
  127. begin
  128.   inherited SetupWindow;
  129. end;
  130.  
  131. procedure TClassWin.DeleteItem;
  132. begin
  133.   FreeMem(p,sizeof(TClassEntry));
  134. end;
  135.  
  136. function TClassWin.GetItemString(p: Pointer): PChar;
  137. var
  138.   CEP: PClassEntry absolute p;
  139.   Temp: array[0..(12+Max_CLASSNAME)] of char;
  140.   ModName: array[0..fsFileName] of char;
  141.   WndClass: TWndClass;
  142.   GlobalClass: Boolean;
  143. begin
  144.   with CEP^ do
  145.   begin
  146.     if GetClassInfo(hInst,szClassName,WndClass) then
  147.     begin
  148.       Temp[0] := #0;
  149.       GlobalClass :=(WndClass.Style and CS_GLOBALCLASS) <> 0;
  150.       if GlobalClass then
  151.         StrCopy(Temp,'[');
  152.       StrCat(Temp,GetModuleName(hInst,ModName));
  153.       if GlobalClass then
  154.         StrCat(Temp,'] ')
  155.       else
  156.         StrCat(Temp,'.');
  157.         StrCat(Temp,szClassName);
  158.     end
  159.     else
  160.       StrCopy(Temp,'>>> Deleted Class <<<');
  161.   end;
  162.   GetItemString := StrNew(Temp);
  163. end;
  164.  
  165. function TClassWin.HandleSelect(LeftClick: Boolean): Boolean;
  166. var
  167.   CEP: PClassEntry;
  168. begin
  169.   HandleSelect := true;
  170.   CEP := PClassEntry(SendMessage(List^.hWindow,LB_GETITEMDATA,List^.GetSelIndex,0));
  171.   with CEP^ do
  172.     if not IsValidSelector(hInst) then
  173.     begin
  174.       BWCCMessageBox(hWindow,'Class no longer exists','Class Info',MB_OK);
  175.       List^.DeleteString(List^.GetSelIndex);
  176.       Exit;
  177.     end;
  178.   Application^.ExecDialog(New(PClassDlg,Init(@Self,CEP)));
  179. end;
  180.  
  181. end.
  182.